home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Files.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-10-17  |  24.7 KB  |  633 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 17 Oct 95
  6. Syntax10b.Scn.Fnt
  7. FoldElems
  8. MarkElems
  9. Alloc
  10. MODULE Files;    (* CM/HM/CS 
  11. IMPORT SYSTEM, Sys, Kernel, Dsp, Directories, Strings;
  12. CONST
  13.     nofbufs = 4;    (* buffers per file *)
  14.     bufSize = 4096;    (* size of each buffer *)
  15.     fileTabSize = 64;    (* maximum number of simultaneously open access paths *)
  16.     none = -1;
  17.     noErr = 0;    (* no error *)
  18.     fnfErr = -43;     (* file not found error *)
  19.     File* = POINTER TO FileDesc;
  20.     Buffer = POINTER TO BufDesc;
  21.     FileDesc = RECORD
  22.         name: Sys.Str63;    (*name under which the file is to be registered (pure file name)*)
  23.         spec: Sys.FSSpec;     (*file specification for MacOS*)
  24.         refNum: INTEGER;    (*file reference number*)
  25.         registered: BOOLEAN;     (*TRUE if opened with Old or if Registered*)
  26.         ix: INTEGER;    (*file table index*)
  27.         swapper: INTEGER;    (*index of next buffer to swap *)
  28.         len, time, date: LONGINT;
  29.         buf: ARRAY nofbufs OF Buffer
  30.     END;
  31.     BufDesc = RECORD
  32.         f: File; 
  33.         changed: BOOLEAN; 
  34.         org, size: LONGINT; 
  35.         data: ARRAY bufSize OF SYSTEM.BYTE
  36.     END;
  37.     Rider* = RECORD 
  38.         res*: LONGINT;
  39.         eof*: BOOLEAN;
  40.         buf: Buffer; 
  41.         org, offset: LONGINT
  42.     END;
  43.     B2 = ARRAY 2 OF CHAR;
  44.     B4 = ARRAY 4 OF CHAR;
  45.     B8 = ARRAY 8 OF CHAR;
  46.     (*----- LoaderOld has to be the first variable in the data segment *) 
  47.     LoaderOld: PROCEDURE (spec: Sys.FSSpec; VAR res: INTEGER);
  48.     LoaderGetPaths: PROCEDURE;    (*unused*)
  49.     tempno: LONGINT;
  50.     nofpaths: INTEGER;
  51.     fileTab: ARRAY fileTabSize OF LONGINT; (* = File *)
  52. PROCEDURE^ DeleteFile (spec: Sys.FSSpec; VAR res: INTEGER);    
  53. PROCEDURE 
  54. SetStr255 (VAR in: ARRAY OF CHAR; VAR out: Sys.Str255);    
  55.     VAR i: INTEGER;
  56. BEGIN
  57.     i := 0; WHILE in[i] # 0X DO out[i+1] := in[i]; INC(i) END;
  58.     out[0] := CHR(i)
  59. END SetStr255;
  60. PROCEDURE 
  61. MakeSpec (VAR name: ARRAY OF CHAR; VAR spec: Sys.FSSpec; VAR res: INTEGER);    
  62.     VAR s: Sys.Str255; startupDir: Directories.Directory; n: ARRAY 256 OF CHAR; 
  63. BEGIN
  64.     COPY (name, n);
  65.     IF n[0] = "$" THEN
  66.         startupDir := Directories.Startup ();
  67.         Strings.Delete(n, 0, 1); Strings.Insert(Directories.delimiter, 0, n); Strings.Insert(startupDir.path, 0, n)
  68.     END;
  69.     SetStr255(n, s);
  70.     res := Sys.FSMakeFSSpec(0, 0, s, spec)
  71.     (*name with path: vRefNum and parID are ignored; name without path: 0, 0 means default directory*)
  72. END MakeSpec;
  73. PROCEDURE 
  74. GetName (spec: Sys.FSSpec; VAR path, name: ARRAY OF CHAR);    
  75.     VAR s: Sys.Str255; v, res, i, j: INTEGER; d: LONGINT; sp: Sys.FSSpec; buf: ARRAY 128 OF CHAR;
  76. BEGIN
  77.     j := 128; s := ""; v := spec.vRefNum; d := spec.parID;
  78.     REPEAT
  79.         DEC(j); buf[j] := ":"; 
  80.         res := Sys.FSMakeFSSpec(v, d, s, sp);
  81.         FOR i := ORD(sp.name[0]) TO 1 BY -1 DO DEC(j); buf[j] := sp.name[i] END;
  82.         d := sp.parID
  83.     UNTIL d = 1;
  84.     i := 0; REPEAT path[i] := buf[j]; INC(i); INC(j) UNTIL j = 127;
  85.     path[i] := 0X;
  86.     FOR i := 0 TO ORD(spec.name[0])-1 DO name[i] := spec.name[i+1] END;
  87.     name[i] := 0X
  88. END GetName;
  89. PROCEDURE 
  90. GetTempName (VAR name: Sys.Str63);    
  91.     VAR n, i: LONGINT;
  92. BEGIN    
  93.     INC(tempno); n := tempno; name := " Oberon.Tmp.0000000000"; name[0] := CHR(21); i := 21;
  94.     WHILE n # 0 DO 
  95.         name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; DEC(i)
  96. END GetTempName;
  97. PROCEDURE 
  98. GetIndex (VAR ix: INTEGER);    
  99. BEGIN
  100.     FOR ix := 0 TO fileTabSize -1 DO
  101.         IF fileTab[ix] = 0 THEN RETURN END
  102.     END;
  103.     HALT(21) (*too many files open*)
  104. END GetIndex;
  105. PROCEDURE 
  106. GetFileDate (spec: Sys.FSSpec; VAR t, d: LONGINT; VAR res: INTEGER);    
  107.     VAR pb: Sys.CInfoPBFileRec;
  108. BEGIN
  109.     pb.ioCompletion := 0; pb.ioNamePtr := SYSTEM.ADR(spec.name);
  110.     pb.ioVRefNum := spec.vRefNum; pb.ioDirID := spec.parID; pb.ioFDirIndex := 0; 
  111.     Sys.PBHGetFInfo(SYSTEM.VAL(Sys.CInfoPBFilePtr, SYSTEM.ADR(pb)));
  112.     res := pb.ioResult; ASSERT(res = noErr);
  113.     Sys.ConvertTime(pb.ioFlMdDat, t, d)
  114. END GetFileDate;
  115. PROCEDURE 
  116. OpenFile (f: File; permssn: SHORTINT);    
  117.     VAR res: INTEGER;
  118. BEGIN (*f exists on disk*)
  119.     res := Sys.FSpOpenDF(f.spec, permssn, f.refNum); 
  120.     ASSERT((res = noErr) OR (res = -49), 22); (* workaround: accept error -49 *)
  121.     IF nofpaths = fileTabSize - 1 THEN
  122.         Kernel.GC;
  123.         IF nofpaths = fileTabSize - 1 THEN res := Sys.FSClose(f.refNum); HALT(21) END
  124.     END;
  125.     INC(nofpaths);
  126.     GetIndex(f.ix); fileTab[f.ix] := SYSTEM.VAL(LONGINT, f);
  127.     GetFileDate(f.spec, f.time, f.date, res); ASSERT(res = noErr, 23)
  128. END OpenFile;
  129. PROCEDURE 
  130. ThisFile (spec: Sys.FSSpec): File;    
  131.     VAR i, j, len: INTEGER; f: File;
  132. BEGIN
  133.     len := ORD(spec.name[0]);
  134.     FOR i := 0 TO fileTabSize - 1 DO
  135.         IF fileTab[i] # 0 THEN
  136.             f := SYSTEM.VAL(File, fileTab[i]);
  137.             IF (f.spec.vRefNum = spec.vRefNum) & (f.spec.parID = spec.parID) & (ORD(f.spec.name[0]) = len) THEN
  138.                 j := 1;
  139.                 WHILE (j <= len) & (CAP(spec.name[j]) = CAP(f.spec.name[j])) DO INC(j) END;
  140.                 IF j > len THEN Dsp.String("--- found"); Dsp.Ln; RETURN f END
  141.             END
  142.         END
  143.     END;
  144.     RETURN NIL
  145. END ThisFile;
  146. PROCEDURE 
  147. RenameFile (spec: Sys.FSSpec; VAR newName: Sys.Str63; VAR res: INTEGER);    
  148. (*newName is pure file name => renames only in same directory*)
  149.     VAR newSpec: Sys.FSSpec; s: Sys.Str255; i: INTEGER;
  150. BEGIN
  151.     FOR i := 0 TO ORD(newName[0]) DO s[i] := newName[i] END;
  152.     res := Sys.FSMakeFSSpec(spec.vRefNum, spec.parID, s, newSpec);
  153.     IF res = noErr THEN DeleteFile(newSpec, res) END;
  154.     res := Sys.FSpRename(spec, s);
  155. END RenameFile;
  156. PROCEDURE 
  157. DeleteFile (spec: Sys.FSSpec; VAR res: INTEGER);    
  158. (*if specified file is in fileTab then unregister it else delete it*)
  159.     VAR f: File; temp: Sys.Str63;
  160. BEGIN
  161.     f := ThisFile(spec);
  162.     IF f = NIL THEN res := Sys.FSpDelete(spec)
  163.     ELSE (*make it a temporary*)
  164.         GetTempName(temp); RenameFile(f.spec, temp, res);
  165.         IF res = noErr THEN f.registered := FALSE; f.spec.name := temp; f.name := temp END
  166. END DeleteFile;
  167. PROCEDURE 
  168. Create (f: File);    
  169. (*called for temporary files if one of their buffers gets read or written*)
  170.     VAR res: INTEGER;
  171. BEGIN (*f.ix = none*)
  172.     GetTempName(f.spec.name); (*rest of f.spec already ok*)
  173.     DeleteFile(f.spec, res);
  174.     res := Sys.FSpCreate(f.spec, Sys.ApplSig, Sys.FileSig, Sys.smSystemScript); ASSERT(res = noErr);
  175.     OpenFile(f, Sys.fsRdWrPerm)
  176. END Create;
  177. PROCEDURE 
  178. ReadBlock (refNum, posmode: INTEGER; pos, count: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; VAR res: INTEGER);    
  179. BEGIN
  180.     res := Sys.SetFPos(refNum, posmode, pos);
  181.     IF res = noErr THEN res := Sys.FSRead(refNum, count, SYSTEM.ADR(buf)) END
  182. END ReadBlock;
  183. PROCEDURE 
  184. WriteBlock (refNum: INTEGER; pos, count: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; VAR res: INTEGER);    
  185.     VAR logEOF: LONGINT; allocSize: LONGINT;
  186. BEGIN
  187.     res := Sys.GetEOF(refNum, logEOF); ASSERT(res = noErr);
  188.     IF (pos + count) > logEOF THEN
  189.         allocSize := pos + count - logEOF;
  190.         res := Sys.Allocate(refNum, allocSize); ASSERT(res = noErr);
  191.         res := Sys.SetEOF(refNum, pos + count); ASSERT(res = noErr)
  192.     END;
  193.     res := Sys.SetFPos(refNum, Sys.fsFromStart, pos); ASSERT(res = noErr);
  194.     res := Sys.FSWrite(refNum, count, SYSTEM.ADR(buf))
  195. END WriteBlock;
  196. PROCEDURE 
  197. Flush (buf: Buffer);    
  198.     VAR f: File; res: INTEGER;
  199. BEGIN
  200.     IF buf.changed THEN
  201.         f := buf.f;
  202.         IF f.ix = none THEN Create(f) END;
  203.         WriteBlock(f.refNum, buf.org, buf.size, buf.data, res);
  204.         buf.changed := FALSE
  205. END Flush;
  206. PROCEDURE 
  207. Old* (name: ARRAY OF CHAR): File;    
  208.     VAR spec: Sys.FSSpec; res: INTEGER; f: File; i: INTEGER;
  209. BEGIN
  210.     IF name = "" THEN RETURN NIL END;
  211.     (*IF name = "DUMP" THEN Dump; RETURN NIL END;*)
  212.     MakeSpec(name, spec, res);
  213.     IF res # noErr THEN
  214.         i := 0; WHILE (name[i] # 0X) & (name[i] # ":") DO INC(i) END;
  215.         IF name[i] = 0X THEN LoaderOld(spec, res) END
  216.     END;
  217.     IF res = noErr THEN (*found in current dir, paths or appl.dir*)
  218.         f := ThisFile(spec);
  219.         IF f = NIL THEN
  220.             NEW(f); f.spec := spec; f.name := f.spec.name;
  221.             OpenFile(f, Sys.fsRdWrPerm);
  222.             res := Sys.GetEOF(f.refNum, f.len); ASSERT(res = noErr);
  223.             f.registered := TRUE; f.swapper := -1
  224.         END
  225.     ELSE f := NIL
  226.     END;
  227.     RETURN f
  228. END Old;
  229. PROCEDURE 
  230. New* (name: ARRAY OF CHAR): File;    
  231.     VAR f: File; res: INTEGER;
  232. BEGIN
  233.     NEW(f); MakeSpec(name, f.spec, res); f.name := f.spec.name;
  234.     f.ix := none; f.len := 0; f.refNum := -1; f.time := 0; f.date := 0; f.swapper := -1; f.registered := FALSE;
  235.     RETURN f
  236. END New;
  237. PROCEDURE 
  238. Close* (f: File);    
  239.     VAR i: INTEGER;
  240. BEGIN
  241.     IF f.ix = none THEN Create(f) END;
  242.     i := 0;
  243.     WHILE (i < nofbufs) & (f.buf[i] # NIL) DO Flush(f.buf[i]); INC(i) END
  244. END Close;
  245. PROCEDURE 
  246. Register* (f: File);    
  247. (* no registration if f.registered, i.e. opened with Old or already Registered before*)
  248.     VAR res: INTEGER; path, name: ARRAY 128 OF CHAR;
  249. BEGIN
  250.     IF f.ix = none THEN (*opened with New but not yet created; f.spec already specifies f.name*)
  251.         DeleteFile(f.spec, res); 
  252.         res := Sys.FSpCreate(f.spec, Sys.ApplSig, Sys.FileSig, Sys.smSystemScript); ASSERT(res = noErr);
  253.         OpenFile(f, Sys.fsRdWrPerm)
  254.     ELSIF ~f.registered THEN
  255.         RenameFile(f.spec, f.name, res);
  256.         IF res = noErr THEN f.spec.name := f.name END
  257.     END;
  258.     f.registered := TRUE;
  259.     Close(f);
  260.     GetName(f.spec, path, name); Directories.notify(Directories.insert, path, name)
  261. END Register;
  262. PROCEDURE 
  263. Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);    
  264.     (** return codes: res = 0: file deleted; res = 3: name is not well formed *)
  265.     VAR spec: Sys.FSSpec; path, nm: ARRAY 128 OF CHAR;
  266. BEGIN
  267.     MakeSpec(name, spec, res);
  268.     IF (res # noErr) & (res # fnfErr) THEN res := 3; RETURN END;
  269.     GetName(spec, path, nm);
  270.     IF res = noErr THEN DeleteFile(spec, res) END;
  271.     IF res = noErr THEN res := 0; Directories.notify(Directories.delete, path, nm) ELSE res := 2 END
  272. END Delete;
  273. PROCEDURE 
  274. Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);    
  275.     (** return codes: res = 0: file renamed; res = 1: new name already exists and is now associated with the new file;
  276.         res = 2: old name is not in directory; res = 3: name is not well formed; res = 5: other error *)
  277.     VAR oldSpec, newSpec, spec: Sys.FSSpec; f: File; retval, i, j: INTEGER;
  278.         oldPath, newPath, oldName, newName: ARRAY 128 OF CHAR;
  279. BEGIN
  280.     res := 0;
  281.     MakeSpec(old, oldSpec, retval); IF retval # noErr THEN res := 2; RETURN END;
  282.     MakeSpec(new, newSpec, retval); IF ~ ((retval = noErr) OR (retval = fnfErr)) THEN res := 3; RETURN END;
  283.     GetName(oldSpec, oldPath, oldName); GetName(newSpec, newPath, newName);
  284.     IF retval # fnfErr THEN 
  285.         DeleteFile(newSpec, retval);
  286.         IF retval = noErr THEN res := 1 END
  287.     END;
  288.     IF (oldSpec.vRefNum = newSpec.vRefNum) & (oldSpec.parID = newSpec.parID) THEN (*same directory*)
  289.         RenameFile(oldSpec, newSpec.name, retval); ASSERT(retval = 0);
  290.         f := ThisFile(oldSpec);
  291.         IF f # NIL THEN f.spec.name := newSpec.name; f.name := newSpec.name END
  292.     ELSE (*move to other directory*)
  293.         MakeSpec(newPath, spec, retval); ASSERT(retval = 0);
  294.         retval := Sys.FSpCatMove(oldSpec, spec);
  295.         IF retval = noErr THEN
  296.             IF f # NIL THEN
  297.                 MakeSpec(new, newSpec, retval); f.spec.parID := newSpec.parID
  298.             END
  299.         END;
  300.         IF retval # noErr THEN res := 5 END 
  301.     END;
  302.     IF res <= 1 THEN
  303.         Directories.notify(Directories.delete, oldPath, oldName);
  304.         Directories.notify(Directories.insert, newPath, newName)
  305. END Rename;
  306. PROCEDURE 
  307. Purge* (f: File);    
  308.     VAR i, res: INTEGER;
  309. BEGIN    
  310.     FOR i := 0 TO nofbufs-1 DO
  311.         IF f.buf[i] # NIL THEN f.buf[i].org := -1; f.buf[i] := NIL END
  312.     END;
  313.     IF f.ix # none THEN
  314.         res := Sys.SetEOF(f.refNum, 0);
  315.         GetFileDate(f.spec, f.time, f.date, res)
  316.     END;
  317.     f.len := 0; f.swapper := -1
  318. END Purge;
  319. PROCEDURE 
  320. GetDate* (f: File; VAR time, date: LONGINT);    
  321. BEGIN
  322.     time := f.time; date := f.date
  323. END GetDate;
  324. PROCEDURE 
  325. Base* (VAR r: Rider): File;    
  326. BEGIN
  327.     RETURN r.buf.f
  328. END Base;
  329. PROCEDURE 
  330. Pos* (VAR r: Rider): LONGINT;    
  331. BEGIN
  332.     RETURN r.org + r.offset
  333. END Pos;
  334. PROCEDURE 
  335. Length* (f: File): LONGINT;    
  336. BEGIN
  337.     RETURN f.len
  338. END Length;
  339. PROCEDURE 
  340. Set* (VAR r: Rider; f: File; pos: LONGINT);    
  341.     VAR org, offset, i: LONGINT; buf: Buffer; res: INTEGER;
  342. BEGIN
  343.     IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END;
  344.     offset := pos MOD bufSize; org := pos - offset;
  345.     i := 0;
  346.     WHILE (i < nofbufs) & (f.buf[i] # NIL) & (org # f.buf[i].org) DO INC(i) END;
  347.     IF i < nofbufs THEN
  348.         IF f.buf[i] = NIL THEN (*f.buf[i..bufSize-1] empty*)
  349.             NEW(buf); buf.changed := FALSE; buf.org := -1; buf.f := f; f.buf[i] := buf
  350.         ELSE (*org = f.buf[i].org*)
  351.             buf := f.buf[i]
  352.         END
  353.     ELSE (*all buffers full => swap*)
  354.         f.swapper := (f.swapper + 1) MOD nofbufs;
  355.         buf := f.buf[f.swapper]; Flush(buf)
  356.     END;
  357.     IF buf.org # org THEN
  358.         IF org = f.len THEN buf.size := 0
  359.         ELSE
  360.             IF f.ix = none THEN Create(f) END;
  361.             IF f.len - org < bufSize THEN buf.size := f.len - org ELSE buf.size := bufSize END;
  362.             ReadBlock(f.refNum, Sys.fsFromStart, org, buf.size, buf.data, res)
  363.         END;
  364.         buf.org := org; buf.changed := FALSE
  365.     END;
  366.     r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
  367. END Set;
  368. (* Data in files is stored in little endian format: the least significant byte gets the least address in the file. Thus the read data must
  369. be converted to big endian (as the PowerPC is a big endian machine) by exchanging the most significant byte with the least
  370. significant byte. Furthermore the ordering of the bits in a set has changed: On the 68k and x86 the bit 0 is the rightmost bit, on the
  371. PowerPC the bit 0 is the leftmost bit. So the bits have to be exchanged too. *)
  372. PROCEDURE 
  373. Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);    
  374.     VAR buf: Buffer; offset: LONGINT;
  375. BEGIN
  376.     buf := r.buf; offset := r.offset;
  377.     IF r.org # buf.org THEN
  378.         Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
  379.     END;
  380.     IF offset < buf.size THEN
  381.         x := buf.data[offset]; r.offset := offset + 1; RETURN
  382.     ELSIF r.org + offset < buf.f.len THEN
  383.         Set(r, r.buf.f, r.org + offset); 
  384.         x := r.buf.data[0]; r.offset := 1
  385.     ELSE    
  386.         x := 0X; r.eof := TRUE    
  387. END Read;
  388. PROCEDURE 
  389. ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);    
  390.     VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
  391. BEGIN
  392.     ASSERT(n <= LEN(x)); 
  393.     xpos := 0; buf := r.buf; offset := r.offset;
  394.     WHILE n > 0 DO
  395.         IF (r.org # buf.org) OR (offset >= bufSize) THEN
  396.             Set(r, buf.f, r.org + offset);                 
  397.             buf := r.buf; offset := r.offset
  398.         END;
  399.         restInBuf := buf.size - offset;
  400.         IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
  401.         ELSIF n > restInBuf THEN min := restInBuf
  402.         ELSE min := n    
  403.         END;
  404.         SYSTEM.MOVE(SYSTEM.ADR(buf.data[offset]), SYSTEM.ADR(x[xpos]), min); 
  405.         INC(offset, min);
  406.         r.offset := offset; 
  407.         INC(xpos, min); DEC(n, min)
  408.     END;
  409.     r.res := n; r.eof := FALSE
  410. END ReadBytes;
  411. PROCEDURE 
  412. ReadInt* (VAR R: Rider; VAR x: INTEGER);    
  413.     VAR b: B2;
  414. BEGIN    
  415.     Read(R, b[1]); Read(R, b[0]); x := SYSTEM.VAL(INTEGER, b)
  416. END ReadInt;
  417. PROCEDURE 
  418. ReadLInt* (VAR R: Rider; VAR x: LONGINT);    
  419.     VAR b, c: B4;
  420. BEGIN
  421.     ReadBytes(R, b, 4); 
  422.     c[0] := b[3]; c[1] := b[2]; c[2] := b[1]; c[3] := b[0]; x:=SYSTEM.VAL(LONGINT, c)
  423. END ReadLInt;
  424. PROCEDURE 
  425. ReadSet* (VAR R: Rider; VAR x: SET);    
  426.     VAR b, c: B4; y: SET; i: INTEGER;
  427. BEGIN
  428.     ReadBytes(R, b, 4); 
  429.     c[0] := b[3]; c[1] := b[2]; c[2] := b[1]; c[3] := b[0]; y:=SYSTEM.VAL(SET, c);
  430.     x := {}; i := 0;
  431.     WHILE i < 32 DO
  432.         IF i IN y THEN INCL(x, 31 - i) END;
  433.         INC(i)
  434. END ReadSet;
  435. PROCEDURE 
  436. ReadBool* (VAR R: Rider; VAR x: BOOLEAN);    
  437.     VAR ch: CHAR;
  438. BEGIN
  439.     Read(R, ch); x:= ch # 0X
  440. END ReadBool;
  441. PROCEDURE 
  442. ReadReal* (VAR R: Rider; VAR x: REAL);    
  443.     VAR b, c: B4;
  444. BEGIN
  445.     ReadBytes(R, b, 4); 
  446.     c[0] := b[3]; c[1] := b[2]; c[2] := b[1]; c[3] := b[0]; x:=SYSTEM.VAL(REAL, c)
  447. END ReadReal;
  448. PROCEDURE 
  449. ReadLReal* (VAR R: Rider; VAR x: LONGREAL);    
  450.     VAR b, c: B8;
  451. BEGIN
  452.     ReadBytes(R, b, 8); 
  453.     c[0] := b[7]; c[1] := b[6]; c[2] := b[5]; c[3] := b[4]; c[4] := b[3]; c[5] := b[2]; c[6] := b[1]; c[7] := b[0];
  454.     x:=SYSTEM.VAL(LONGREAL, c)
  455. END ReadLReal;
  456. PROCEDURE 
  457. ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);    
  458.     VAR i, len: INTEGER; ch: CHAR;
  459. BEGIN
  460.     i:=0; len:=SHORT(LEN(x));
  461.     REPEAT
  462.         Read(R, ch); x[i]:=ch; INC(i)
  463.     UNTIL (ch = 0X) OR (i = len);
  464.     IF i = len THEN x[len - 1] := 0X END
  465. END ReadString;
  466. PROCEDURE 
  467. ReadNum* (VAR R: Rider; VAR x: LONGINT);    
  468.     VAR s: SHORTINT; ch: CHAR; y: LONGINT;
  469. BEGIN    
  470.     s := 0; y := 0;
  471.     Read(R, ch);
  472.     WHILE ch >= 80X DO    
  473.         INC(y, ASH(LONG(ch) - 128, s)); INC(s, 7); 
  474.         Read(R, ch)
  475.     END;
  476.     x := ASH(SYSTEM.LSH(LONG(ch), 25), s - 25) + y
  477. END ReadNum;
  478. PROCEDURE 
  479. Write* (VAR r: Rider; x: SYSTEM.BYTE);    
  480.     VAR buf: Buffer; offset: LONGINT;
  481. BEGIN
  482.     buf := r.buf; offset := r.offset;
  483.     IF (r.org # buf.org) OR (offset >= bufSize) THEN 
  484.         Set(r, buf.f, r.org + offset); 
  485.         buf := r.buf; offset := r.offset
  486.     END;
  487.     buf.data[offset] := x; buf.changed := TRUE;
  488.     IF offset = buf.size THEN INC(buf.size); INC(buf.f.len) END;
  489.     r.offset := offset + 1
  490. END Write;
  491. PROCEDURE 
  492. WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);    
  493.     VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
  494. BEGIN
  495.     ASSERT(n <= LEN(x)); 
  496.     xpos := 0; buf := r.buf; offset := r.offset;
  497.     WHILE n > 0 DO
  498.         IF (r.org # buf.org) OR (offset >= bufSize) THEN 
  499.             Set(r, buf.f, r.org + offset); 
  500.             buf := r.buf; offset := r.offset            
  501.         END;
  502.         restInBuf := bufSize - offset;
  503.         IF n < restInBuf THEN min := n ELSE min := restInBuf END;
  504.         SYSTEM.MOVE(SYSTEM.ADR(x[xpos]), SYSTEM.ADR(buf.data[offset]), min); 
  505.         INC(offset, min); r.offset := offset;
  506.         IF offset > buf.size THEN
  507.             INC(buf.f.len, offset - buf.size); 
  508.             buf.size := offset
  509.         END;
  510.         INC(xpos, min); DEC(n, min); 
  511.         buf.changed:=TRUE
  512. END WriteBytes;
  513. PROCEDURE 
  514. WriteInt* (VAR R: Rider; x: INTEGER);    
  515.     VAR b, c: B2;
  516. BEGIN
  517.     c := SYSTEM.VAL(B2, x); b[0] := c[1]; b[1] := c[0]; WriteBytes(R, b, 2)
  518. END WriteInt;
  519. PROCEDURE 
  520. WriteLInt* (VAR R: Rider; x: LONGINT);    
  521.     VAR b, c: B4;
  522. BEGIN
  523.     c := SYSTEM.VAL(B4, x); b[0] := c[3]; b[1] := c[2]; b[2] := c[1]; b[3] := c[0]; WriteBytes(R, b, 4)
  524. END WriteLInt;
  525. PROCEDURE 
  526. WriteSet* (VAR R: Rider; x: SET);    
  527.     VAR y: SET; i: INTEGER; b, c: B4;
  528. BEGIN
  529.     y := {}; i := 0;
  530.     WHILE i < 32 DO 
  531.         IF i IN x THEN INCL(y, 31-i) END; 
  532.         INC(i) 
  533.     END;
  534.     c := SYSTEM.VAL(B4, y); b[0] := c[3]; b[1] := c[2]; b[2] := c[1]; b[3] := c[0];
  535.     WriteBytes(R, b, 4)
  536. END WriteSet;
  537. PROCEDURE 
  538. WriteBool* (VAR R: Rider; x: BOOLEAN);    
  539. BEGIN
  540.     IF x THEN Write(R, 1X) ELSE Write(R, 0X) END
  541. END WriteBool;
  542. PROCEDURE 
  543. WriteReal* (VAR R: Rider; x: REAL);    
  544.     VAR b, c: B4;
  545. BEGIN
  546.     c := SYSTEM.VAL(B4, x); b[0] := c[3]; b[1] := c[2]; b[2] := c[1]; b[3] := c[0]; WriteBytes(R, b, 4)
  547. END WriteReal;
  548. PROCEDURE 
  549. WriteLReal* (VAR R: Rider; x: LONGREAL);    
  550.     VAR b, c: B8;
  551. BEGIN
  552.     c := SYSTEM.VAL(B8, x);
  553.     b[0] := c[7]; b[1] := c[6]; b[2] := c[5]; b[3] := c[4]; b[4] := c[3]; b[5] := c[2]; b[6] := c[1]; b[7] :=c [0]; 
  554.     WriteBytes(R, b, 8)
  555. END WriteLReal;
  556. PROCEDURE 
  557. WriteString* (VAR R: Rider; x: ARRAY OF CHAR);    
  558.     VAR i: INTEGER;
  559. BEGIN    
  560.     i := 0;
  561.     WHILE x[i] # 0X DO INC(i) END;
  562.     WriteBytes(R, x, i + 1)
  563. END WriteString;
  564. PROCEDURE 
  565. WriteNum* (VAR R: Rider; x: LONGINT);    
  566. BEGIN
  567.     WHILE (x < -64) OR (x > 63) DO
  568.         Write(R, CHR(x MOD 128 + 128)); 
  569.         x:=x DIV 128
  570.     END;
  571.     Write(R, CHR(x MOD 128))
  572. END WriteNum;
  573. PROCEDURE 
  574. CollectFiles; (*called between mark and sweep phase of garbage collector*)    
  575.     VAR i: LONGINT; s: SET; f: File; res: INTEGER;
  576. BEGIN    
  577.     FOR i := 0 TO fileTabSize - 1 DO
  578.         IF fileTab[i] # 0 THEN
  579.             f := SYSTEM.VAL(File, fileTab[i]);
  580.             SYSTEM.GET(SYSTEM.VAL(LONGINT, f) - 4, s);
  581.             IF ~(Kernel.MarkBit IN s) THEN (*not marked in the mark phase*)
  582.                 fileTab[i]:=0; DEC(nofpaths);
  583.                 res := Sys.FSClose(f.refNum); ASSERT(res = noErr);
  584.                 IF ~f.registered THEN res := Sys.FSpDelete(f.spec) END
  585.             END
  586.         END
  587.     END;
  588. END CollectFiles;
  589. PROCEDURE 
  590. Dismount; (*called before PowerMac Oberon is quit*)    
  591.     VAR s: Sys.Str255; res: INTEGER;
  592. BEGIN
  593.     CollectFiles;
  594.     s[0] := 0X; res := Sys.FlushVol(SYSTEM.ADR(s), 0);
  595. END Dismount;
  596. (*PROCEDURE 
  597. DS (spec: Sys.FSSpec);    
  598.     VAR i: INTEGER;
  599. BEGIN
  600.     Dsp.String("vRefNum="); Dsp.Int(spec.vRefNum);
  601.     Dsp.String(", parID="); Dsp.Int(spec.parID);
  602.     Dsp.String("  ");
  603.     FOR i := 1 TO ORD(spec.name[0]) DO Dsp.Char(spec.name[i]) END;
  604.     Dsp.Ln
  605. END DS;
  606. PROCEDURE 
  607. Dump;    
  608.     VAR i, j: INTEGER; f: File;
  609. BEGIN
  610.     FOR i := 0 TO fileTabSize -1 DO
  611.         IF fileTab[i] # 0 THEN
  612.             f := SYSTEM.VAL(File, fileTab[i]);
  613.             Dsp.Int(i); Dsp.Char(" ");
  614.             FOR j := 1 TO ORD(f.name[0]) DO Dsp.Char(f.name[j]) END; Dsp.String(" (");
  615.             Dsp.Int(f.spec.vRefNum); Dsp.Char(" ");
  616.             Dsp.Int(f.spec.parID); Dsp.Char(" ");
  617.             FOR j := 1 TO ORD(f.spec.name[0]) DO Dsp.Char(f.spec.name[j]) END; Dsp.String(") ");
  618.             Dsp.Int(f.refNum);
  619.             IF f.registered THEN Dsp.String(" registered ") ELSE Dsp.String(" notRegistered ") END;
  620.             Dsp.Int(f.len); Dsp.Char(" ");
  621.             FOR j := 0 TO nofbufs-1 DO
  622.                 IF f.buf[j] = NIL THEN Dsp.Char(".") ELSE Dsp.Char("x") END
  623.             END;
  624.             Dsp.Ln
  625.         END
  626. END Dump;
  627. BEGIN
  628.     tempno := ABS(Sys.TickCount());
  629.     Kernel.gcQ.Add(CollectFiles);
  630.     Kernel.quitQ.Add(Dismount);
  631.     nofpaths := 0
  632. END Files.
  633.